home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 051-060 / amok56 / m2maker / txt / xcopy.mod < prev    next >
Text File  |  1993-11-04  |  13KB  |  422 lines
  1. (*---------------------------------------------------------------------------
  2.   :Program.    M2Maker
  3.   :Author.     Thomas Stolze
  4.   :Address.    Goslarsche Str. 32, W-3000 Hannover 21, Germany
  5.   :Phone.      (0)511 / 75 10 77
  6.   :Version.    V2.3
  7.   :Date.       09-Feb-91
  8.   :Copyright.  Shareware
  9.   :Language.   Modula-2
  10.   :Translator. M2Amiga V4.0d
  11.   :LastUpdate. 05-JUN-91
  12.   :Contents.   Programming Utility.
  13.   :Remark.     Supports the M2Amiga System (C) by A+L AG Switzerland
  14. ---------------------------------------------------------------------------*)
  15.  
  16. IMPLEMENTATION MODULE XCopy;
  17.  
  18. IMPORT FileSystem;
  19.  
  20. FROM Arts          IMPORT BreakPoint,Terminate;
  21. FROM DosD          IMPORT accessRead,Date,
  22.                           FileInfoBlock,FileInfoBlockPtr,
  23.                           FileLockPtr,noFreeStore,objectNotFound,ok,
  24.                           setDate,StandardPacketPtr;
  25. FROM DosL          IMPORT CreateDir,CurrentDir,DeviceProc,
  26.                           DupLock,Examine,ExNext,Lock,UnLock;
  27. FROM ExecD         IMPORT message,MsgPortPtr;
  28. FROM ExecL         IMPORT CopyMem,GetMsg,PutMsg,WaitPort;
  29. FROM ExecSupport   IMPORT CreatePort,DeletePort;
  30. FROM Heap          IMPORT Allocate,Deallocate;
  31. FROM InitIntuition IMPORT PrintStatus;
  32. FROM String        IMPORT CapString,Compare,Concat,Copy,Length;
  33. FROM Storage       IMPORT ALLOCATE,Available,DEALLOCATE;
  34. FROM SYSTEM        IMPORT ADDRESS,ADR,BPTR,CAST;
  35.  
  36. (*FROM InOut       IMPORT WriteInt,WriteLn,WriteString;*)
  37.  
  38. CONST bufferSize = 20480;
  39.  
  40. VAR Buffer : ADDRESS;
  41.     cIPtr  : FileInfoBlockPtr;
  42.  
  43. PROCEDURE AllocEntry(VAR entryPtr: ADDRESS; size : CARDINAL): BOOLEAN;
  44. BEGIN
  45.   IF Available(size) THEN ALLOCATE(entryPtr,size); RETURN TRUE END;
  46.   RETURN FALSE;
  47. END AllocEntry;
  48.  
  49. PROCEDURE DeallocEntry(VAR entryPtr : ADDRESS; size : CARDINAL);
  50. BEGIN
  51.   DEALLOCATE(entryPtr,size); entryPtr:=NIL;
  52. END DeallocEntry;
  53.  
  54. PROCEDURE MakeStandardPacket(ReplyPort : MsgPortPtr;
  55.                              Type,
  56.                              Arg1,Arg2,
  57.                              Arg3,Arg4 : LONGINT): StandardPacketPtr;
  58. VAR PacketPtr : StandardPacketPtr;
  59. BEGIN
  60.   IF AllocEntry(PacketPtr,SIZE(PacketPtr^)) THEN
  61.      IF PacketPtr # NIL THEN
  62.         WITH PacketPtr^ DO
  63.           pkt.link := ADR(msg);        (*  init "DosPacket"  *)
  64.           pkt.port := ReplyPort;
  65.           pkt.type := Type;
  66.           pkt.res1 := 0;
  67.           pkt.res2 := 0;
  68.           pkt.arg1 := Arg1;
  69.           pkt.arg2 := Arg2;
  70.           pkt.arg3 := Arg3;
  71.           pkt.arg4 := Arg4;
  72.           pkt.arg5 := 0;
  73.           pkt.arg6 := 0;
  74.           pkt.arg7 := 0;
  75.           msg.node.name := ADR(pkt);   (*  init "Message" *)
  76.           msg.node.succ := NIL;
  77.           msg.node.pred := NIL;
  78.           msg.node.type := message;
  79.           msg.node.pri  := 0;
  80.           msg.replyPort := ReplyPort;
  81.           msg.length    := SIZE(msg)
  82.         END
  83.      END;
  84.  
  85.      RETURN PacketPtr;
  86.   END;
  87.   RETURN NIL;
  88. END MakeStandardPacket;
  89.  
  90. PROCEDURE FreeStandardPacket(VAR PacketPtr : StandardPacketPtr );
  91. BEGIN
  92.   IF PacketPtr # NIL THEN
  93.      DeallocEntry(PacketPtr,SIZE(PacketPtr^)); PacketPtr:=NIL
  94.   END
  95. END  FreeStandardPacket;
  96.  
  97. PROCEDURE SendPacket(HandlerPort : MsgPortPtr;
  98.                      Type,
  99.                      Arg1,Arg2,
  100.                      Arg3,Arg4   : LONGINT;
  101.                      VAR Result  : LONGINT): LONGINT;
  102. VAR  PacketPtr : StandardPacketPtr;
  103.      myPort    : MsgPortPtr;
  104. BEGIN
  105.   IF HandlerPort = NIL THEN RETURN objectNotFound END;
  106.  
  107.   myPort:= CreatePort(NIL,0);
  108.   IF myPort = NIL THEN RETURN noFreeStore END;
  109.      PacketPtr:=MakeStandardPacket(myPort,Type,Arg1,Arg2,Arg3,Arg4);
  110.   IF PacketPtr = NIL THEN DeletePort(myPort); RETURN noFreeStore END;
  111.  
  112.   PutMsg(HandlerPort,PacketPtr);
  113.   REPEAT
  114.     WaitPort(myPort)
  115.   UNTIL GetMsg(myPort) = PacketPtr;
  116.   WITH PacketPtr^.pkt DO
  117.     Result:=res1; Type:=res2
  118.   END;
  119.   DeletePort(myPort); FreeStandardPacket(PacketPtr);
  120.  
  121.   IF Result = 0 THEN RETURN Type ELSE RETURN ok END;
  122. END SendPacket;
  123.  
  124. PROCEDURE MakeBSTR(Text : ARRAY OF CHAR): BPTR;
  125. VAR  p       : POINTER TO ARRAY [0..1] OF SHORTCARD;
  126.      l       : INTEGER;
  127.      BStrPtr : BPTR;
  128. BEGIN
  129.   l:=INTEGER(Length(Text));
  130.   Allocate(p,l+2);
  131.   BStrPtr:=BPTR(ADDRESS(p));
  132.   IF p # NIL THEN
  133.      p^[0]:=SHORTCARD(l); INC(p); CopyMem(ADR(Text[0]),p,l); INC(p,l); p^[0]:=0;
  134.   END;
  135.   RETURN BStrPtr
  136. END MakeBSTR;
  137.  
  138. PROCEDURE FreeBSTR(VAR BStrPtr: BPTR );
  139. VAR p : ADDRESS;
  140. BEGIN
  141.   IF BStrPtr # NIL THEN
  142.      p:=ADDRESS(BStrPtr); Deallocate(p); BStrPtr:=NIL
  143.   END
  144. END FreeBSTR;
  145.  
  146. PROCEDURE SetOneDate(name        : ARRAY OF CHAR;
  147.                      date        : Date;
  148.                      currentLock : LONGINT): BOOLEAN;
  149. VAR Response,r : LONGINT;
  150.     FName      : BPTR;
  151.     FDate      : ADDRESS;
  152.     DevicePort : MsgPortPtr;
  153. BEGIN
  154.   FName:=MakeBSTR(name);
  155.   IF FName = NIL THEN
  156.      RETURN FALSE;
  157.   ELSE
  158.     FDate:=ADR(date);
  159.     DevicePort:=DeviceProc(ADR(name));
  160.     IF DevicePort = NIL THEN
  161.        FreeBSTR(FName); RETURN FALSE;
  162.     ELSE
  163.       IF currentLock = 0 THEN
  164.          FreeBSTR(FName); RETURN FALSE;
  165.       ELSE
  166.         Response:=SendPacket(DevicePort,setDate,0,
  167.                              currentLock,CAST(LONGINT,FName),FDate,r);
  168.       END
  169.     END;
  170.     FreeBSTR(FName);
  171.   END;
  172.   RETURN (Response = 0);
  173. END SetOneDate;
  174.  
  175. PROCEDURE MakePath(dir,file : ARRAY OF CHAR; VAR path : ARRAY OF CHAR);
  176. VAR i : INTEGER;
  177. BEGIN
  178.   i:=Length(dir); Copy(path,dir);
  179.   IF i > 0 THEN
  180.      IF (path[i-1] # ":") AND (path[i-1] # "/") THEN Concat(path,"/") END;
  181.   END;
  182.   Concat(path,file);
  183. END MakePath;
  184.  
  185. PROCEDURE FilterLastDir(str : ARRAY OF CHAR; VAR dir : ARRAY OF CHAR);
  186. VAR i,j,k : INTEGER;
  187. BEGIN
  188.    i:=Length(str); j:=0; k:=0;
  189.    REPEAT DEC(i) UNTIL ((i < 0) OR (str[i] = ":")) OR (str[i] = "/");
  190.  
  191.    FOR k:=i+1 TO Length(str) DO dir[j]:=str[k]; INC(j); END;
  192.  
  193.    MakePath(dir,"",dir);
  194. END FilterLastDir;
  195.  
  196. PROCEDURE GetFileDosDate(name : ARRAY OF CHAR; VAR time : Date): BOOLEAN;
  197. VAR lock : FileLockPtr;
  198. BEGIN
  199.   lock:=Lock(ADR(name),accessRead);
  200.   IF lock # NIL THEN
  201.      IF Examine(lock,cIPtr) THEN time:=cIPtr^.date; END;
  202.      UnLock(lock); RETURN TRUE;
  203.   END;
  204.   RETURN FALSE;
  205. END GetFileDosDate;
  206.  
  207. PROCEDURE XCopyFile(name   : ARRAY OF CHAR;
  208.                     src,
  209.                     dest   : FileLockPtr;
  210.                     fInfo  : FileInfoBlockPtr;
  211.                     upDate : BOOLEAN): BOOLEAN;
  212.  
  213. VAR olddestLock : FileLockPtr;
  214.     rfile,sfile : FileSystem.File;
  215.     res         : BOOLEAN;
  216.     rActual,
  217.     sActual     : LONGINT;
  218.  
  219.   PROCEDURE CompareDates(): BOOLEAN;
  220.   VAR lock        : FileLockPtr;
  221.   BEGIN
  222.     IF upDate THEN
  223.        lock:=Lock(ADR(name),accessRead);
  224.        IF lock # NIL THEN
  225.           IF Examine(lock,cIPtr) THEN
  226.              IF cIPtr^.date.days = fInfo^.date.days THEN
  227.                 IF cIPtr^.date.minute = fInfo^.date.minute THEN
  228.                    IF cIPtr^.date.tick = fInfo^.date.tick THEN
  229.                       UnLock(lock); RETURN FALSE;
  230.                    END;
  231.                 END;
  232.              END;
  233.           END;
  234.           UnLock(lock);
  235.        END;
  236.     END;
  237.     RETURN TRUE;
  238.   END CompareDates;
  239.  
  240. BEGIN
  241.   FileSystem.Lookup(rfile,name,bufferSize,FALSE); res:=TRUE;
  242.   IF rfile.res = FileSystem.done THEN
  243.      olddestLock:=CurrentDir(dest);
  244.      IF CompareDates() THEN
  245.         FileSystem.Lookup(sfile,name,bufferSize,TRUE);
  246.         IF sfile.res = FileSystem.done THEN
  247.            REPEAT
  248.              FileSystem.ReadBytes(rfile,Buffer,bufferSize,rActual);
  249.              FileSystem.WriteBytes(sfile,Buffer,rActual,sActual);
  250.            UNTIL rfile.eof;
  251.         END;
  252.         FileSystem.Close(sfile);
  253.           res:=SetOneDate(name,fInfo^.date,LONGINT(dest));
  254.      END;
  255.      dest:=CurrentDir(olddestLock);
  256.   ELSE
  257.     res:=FALSE;
  258.   END;
  259.   FileSystem.Close(rfile);
  260.   RETURN res;
  261. END XCopyFile;
  262.  
  263. PROCEDURE XCopySubDirectories(src,dest : FileLockPtr; type : XType): BOOLEAN;
  264. VAR oldLock,
  265.     newLock,
  266.     dLock       : FileLockPtr;
  267.     counter     : CARDINAL;
  268.     name        : ARRAY [0..31] OF CHAR;
  269.     fileInfoPtr : FileInfoBlockPtr;
  270.  
  271.     PROCEDURE MakeDestDir(): BOOLEAN;
  272.     VAR oLock : FileLockPtr;
  273.         file  : ARRAY [0..31] OF CHAR;
  274.         res   : BOOLEAN;
  275.     BEGIN
  276.       IF (txt = type) THEN
  277.          Copy(file,name); CapString(file);
  278.          IF Compare("TXT",file) # 0 THEN RETURN FALSE END;
  279.       END;
  280.  
  281.       res:=TRUE;
  282.       oLock:=CurrentDir(dest);
  283.         dLock:=CreateDir(ADR(name));
  284.         IF dLock = NIL THEN
  285.            dLock:=Lock(ADR(name),accessRead);
  286.            IF dLock = NIL THEN res:=FALSE END;
  287.         END;
  288.       dest:=CurrentDir(oLock);
  289.  
  290.       RETURN res;
  291.     END MakeDestDir;
  292. BEGIN
  293.   IF AllocEntry(fileInfoPtr,SIZE(FileInfoBlock)) THEN
  294.      counter:=0; oldLock:=CurrentDir(src);
  295.      IF Examine(src,fileInfoPtr) THEN
  296.         REPEAT
  297.           Copy(name,fileInfoPtr^.fileName);
  298.           IF counter > 0 THEN
  299.              IF fileInfoPtr^.dirEntryType > 0 THEN
  300.                 IF (all = type) OR (txt = type) THEN
  301.                    IF MakeDestDir() THEN;
  302.                       newLock:=Lock(ADR(name),accessRead);
  303.                       IF newLock # NIL THEN
  304.                          IF NOT XCopySubDirectories(newLock,dLock,type) THEN
  305.                             PrintStatus("Copy Error. Error ignored !");
  306.                          END;
  307.                          UnLock(dLock); dLock:=NIL;
  308.                          UnLock(newLock); newLock:=NIL;
  309.                       END;
  310.                    END;
  311.                 END;
  312.              ELSE
  313.                 IF NOT XCopyFile(name,src,dest,fileInfoPtr,TRUE) THEN
  314.                    src:=CurrentDir(oldLock); RETURN FALSE;
  315.                 END;
  316.              END;
  317.           END;
  318.           INC(counter);
  319.         UNTIL (ExNext(src,fileInfoPtr) = FALSE);
  320.         src:=CurrentDir(oldLock);
  321.      END;
  322.      DeallocEntry(fileInfoPtr,SIZE(FileInfoBlock));
  323.      RETURN TRUE;
  324.   ELSE
  325.     RETURN FALSE;
  326.   END;
  327. END XCopySubDirectories;
  328.  
  329. PROCEDURE XCopySingleFile(src,dest : ARRAY OF CHAR): BOOLEAN;
  330. VAR name        : ARRAY [0..31] OF CHAR;
  331.     srcPath,
  332.     destPath    : ARRAY [0..255] OF CHAR;
  333.     srcLock,
  334.     destLock,
  335.     dLock,
  336.     olddestLock : FileLockPtr;
  337.     rfile,sfile : FileSystem.File;
  338.     res         : BOOLEAN;
  339.     rActual,
  340.     sActual     : LONGINT;
  341.  
  342. BEGIN
  343.   MakePath(src,"",srcPath); srcPath[Length(srcPath)-1]:=00C;
  344.   FilterLastDir(srcPath,name);
  345.   MakePath(dest,name,destPath); destPath[Length(destPath)-1]:=00C;
  346.  
  347.   FileSystem.Lookup(rfile,srcPath,bufferSize,FALSE); res:=TRUE;
  348.   IF rfile.res = FileSystem.done THEN
  349.      FileSystem.Lookup(sfile,destPath,bufferSize,TRUE);
  350.      IF sfile.res = FileSystem.done THEN
  351.         REPEAT
  352.           FileSystem.ReadBytes(rfile,Buffer,bufferSize,rActual);
  353.           FileSystem.WriteBytes(sfile,Buffer,rActual,sActual);
  354.         UNTIL rfile.eof;
  355.      END;
  356.      FileSystem.Close(sfile);
  357.      srcLock:=Lock(ADR(srcPath),accessRead);
  358.      IF srcLock # NIL THEN
  359.         IF Examine(srcLock,cIPtr) THEN
  360.            MakePath(dest,"",destPath);
  361.            destLock:=Lock(ADR(destPath),accessRead);
  362.            IF destLock # NIL THEN
  363.               dLock:=DupLock(destLock); UnLock(destLock);
  364.               olddestLock:=CurrentDir(dLock); name[Length(name)-1]:=00C;
  365.                 res:=SetOneDate(name,cIPtr^.date,LONGINT(dLock));
  366.               dLock:=CurrentDir(olddestLock);
  367.               IF dLock # NIL THEN UnLock(dLock); END;
  368.            ELSE
  369.              res:=FALSE;
  370.            END;
  371.         ELSE
  372.            res:=FALSE;
  373.         END;
  374.         UnLock(srcLock);
  375.      ELSE
  376.         res:=FALSE;
  377.      END;
  378.   ELSE
  379.     res:=FALSE;
  380.   END;
  381.   FileSystem.Close(rfile);
  382.   RETURN res;
  383. END XCopySingleFile;
  384.  
  385. PROCEDURE XCopy(src,dest : ARRAY OF CHAR; type : XType): BOOLEAN;
  386. VAR srcLock,
  387.     destLock : FileLockPtr;
  388.     bool     : BOOLEAN;
  389.     name     : ARRAY [0..31] OF CHAR;
  390.     path     : ARRAY [0..255] OF CHAR;
  391. BEGIN
  392.   IF AllocEntry(Buffer,bufferSize) THEN
  393.      IF type # single THEN
  394.         srcLock:=Lock(ADR(src),accessRead);
  395.         IF srcLock = NIL THEN RETURN FALSE END; destLock:=NIL;
  396.  
  397.         src[Length(src)-1]:=00C; FilterLastDir(src,name);
  398.           MakePath(dest,name,path); path[Length(path)-1]:=00C;
  399.         destLock:=CreateDir(ADR(path));
  400.  
  401.         IF destLock = NIL THEN
  402.            destLock:=Lock(ADR(path),accessRead);
  403.            IF destLock = NIL THEN RETURN FALSE END;
  404.         END;
  405.  
  406.         bool:=TRUE;
  407.         IF XCopySubDirectories(srcLock,destLock,type) THEN
  408.            bool:=FALSE;
  409.         END;
  410.         UnLock(srcLock); UnLock(destLock);
  411.      ELSE
  412.         bool:=XCopySingleFile(src,dest);
  413.      END;
  414.      DeallocEntry(Buffer,bufferSize);
  415.   END;
  416.   RETURN bool;
  417. END XCopy;
  418.  
  419. BEGIN
  420.   IF NOT AllocEntry(cIPtr,SIZE(FileInfoBlock)) THEN Terminate END;
  421. END XCopy.
  422.